perm filename QUEENS.LSP[E82,JMC]1 blob sn#674195 filedate 1982-08-27 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 queens.lsp[e82,jmc]	Programs for the n queens problem
C00006 00003	(defun moves (pos) ((lambda (x)
C00007 ENDMK
CāŠ—;
;;; queens.lsp[e82,jmc]	Programs for the n queens problem

(defun queens	; top level n queens program
		; value is a list of solutions extending a position

       (pos	; position as a sequence of occupied squares
	found	; a list of the solutions already found
	exc)	; a list of the positions whose continuations
		; have been explored.  Positions that contain
		; them are excluded by symmetry.
       (if (or (contains pos exc) (lost pos))
	   found
	   (won pos)
	   (cons (outform pos) found)
	   (queens1 pos found exc (moves pos))))


(defun queens1	; scans row, column or (rarely) diagonal
		; value is list of solutions 

       (pos	; position as a sequence of occupied squares
	found	; list of positions already found
	exc	; positions whose continuations have been explored
	l)	; list of remaining moves to be considered
       (if (null l)
	   found
	   (queens1 pos
		    (queens (update pos (car l)) found exc)
		    exc		; needs to be updated
		    (cdr l))))

;;; functions for hand computation

(defun init (n2) (prog ()
		       (setq n n2)
		       (setq n1 (sub1 n))
		       (array bd fixnum n n)
		       (setq m -1)))
(defun try (x y)
       (if (not (zerop (bd x y)))
	   'lose
	   (prog ()
		 (setq m (plus m 2))
		 (store (bd x y) (add1 m))
		 (do i (minus n) (1+ i) (= i n)
		     (if (and (in1 (+ x i) y) (zerop (bd (+ x i) y)))
			 (store (bd (+ x i) y) m))
		     (if (and (in1 x (+ y i)) (zerop (bd x (+ y i))))
			 (store (bd x (+ y i)) m))
		     (if (and (in1 (+ x i) (+ y i)) (zerop (bd (+ x i) (+ y i))))
			 (store (bd (+ x i) (+ y i)) m))
		     (if (and (in1 (+ x i) (- y i)) (zerop (bd (+ x i) (- y i))))
			 (store (bd (+ x i) (- y i)) m))
		     )
		 (show)
		 )
	   )
       )

(defun b () (prog ()
		  (do i 0 (1+ i) (= i n)
		      (do j 0 (1+ j) (= j n) (if (or (equal m (bd i j))
						     (equal (1+ m) (bd i j)))
						 (store (bd i j) 0))))
		  (show)
		  (setq m (- m 2))))

(defun show () (prog ()
		     (terpri)
		     (do i 0 (1+ i) (= i n)
			 (do j 0 (1+ j) (= j n) (show1 (bd i j)))
			 (terpri)
			 )
		     )
       )

(defun show1 (k) (prog ()
		       (princ (if (lessp k 8) "  " " "))
		       (prin1 k)))

(defun in1 (x y) (and (lessp -1 x) (lessp -1 y) (lessp x n) (lessp y n)))

(defun ko (x y) (if (zerop (bd x y))
		    (prog () (store (bd x y) (- n 3)) (show))
		    'lose))
(defun moves (pos) ((lambda (x)

) (classify pos)))